home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)Z / (A)Z11.ADF / LOGO / LOGOSOURCE / procvars.c < prev    next >
C/C++ Source or Header  |  1987-06-29  |  7KB  |  310 lines
  1.  
  2. /*    This file contains stuff about user procedure calls and
  3. * variable assignment and lookup.
  4. *
  5. *    Copyright (C) 1979, The Children's Museum, Boston, Mass.
  6. *    Written by Douglas B. Klunder
  7. */
  8.  
  9. #include "logo.h"
  10. extern struct plist *pcell;
  11. extern int *stkbase;
  12. extern int stkbi;
  13. extern int *newstk;
  14. extern int newsti;
  15. extern int argno;
  16. extern int yylval;
  17. extern int yychar;
  18. extern char *ckzmalloc();
  19. extern short yyerrflag;
  20. static struct alist *globvars;
  21. extern struct stkframe *fbr;
  22. extern struct plist *proclist;
  23. extern struct alist *locptr;
  24. extern struct alist *newloc;
  25.  
  26. struct alist *loclk1();
  27. struct alist *look1();
  28. struct object *look();
  29.  
  30. go(linenum)    /* LOGO go */
  31. register struct object *linenum;
  32. {
  33.     register struct lincell *lptr;
  34.     register numline;
  35.  
  36.     if (pcell==NULL) {    /* not in procedure */
  37.         printf("Go can only be used within a procedure.\n");
  38.         errhand();
  39.     }
  40.     linenum = numconv(linenum,"Go");
  41.     if (!intp(linenum)) ungood("Go",linenum);
  42.     numline = linenum->obint;
  43.     mfree(linenum);
  44. /*    Search for saved line no. */
  45.     for (lptr=pcell->plines;lptr;lptr=lptr->nextline) {
  46.         if (lptr->linenum==numline)
  47.         {    /* line found, so adjust pseudo-code
  48.             * pointers to continue execution at
  49.             * right place
  50.             */
  51.             stkbase=lptr->base;
  52.             stkbi=lptr->index;
  53.             return;
  54.         }
  55.     }
  56.     /* no match */
  57.     printf("There is no line %d.\n",numline);
  58.     errhand();
  59. }
  60.  
  61. char *lowcase(name)
  62. register char *name;
  63. {
  64.     static char result[100];
  65.     register char c,*str;
  66.  
  67.     str = result;
  68.     while (c = *name++) {
  69.         if (c >= 'A' && c <= 'Z') c += 040;
  70.         *str++ = c;
  71.     }
  72.     *str = '\0';
  73.     return(result);
  74. }
  75.  
  76. struct object *lnamep(name)    /* namep */
  77. register struct object *name;
  78. {    /* check for both local and global definitions */
  79.     register char *nstr;
  80.  
  81.     if (!stringp(name)) ungood("Namep",name);
  82.     nstr = lowcase(name->obstr);
  83.     if (loclk1(nstr) || look1(nstr)) {
  84.         mfree(name);
  85.         return(true());
  86.     }
  87.     mfree(name);
  88.     return(false());
  89. }
  90.  
  91. loccreate(varname,lptr)        /* create new local variable cell, with name
  92.                 * but without value */
  93. register struct object *varname;
  94. register struct alist **lptr;
  95. {
  96.     register struct alist *temp1,*temp2;
  97.     char ch,*str;
  98.  
  99.     if (pcell==NULL) {    /* not in procedure */
  100.         printf("Local can only be used within a procedure.\n");
  101.         errhand();
  102.     }
  103.     if (!stringp(varname)) ungood("Local",varname);
  104.     str = lowcase(varname->obstr);
  105.     if ((ch = str[0]) == '\0') {
  106.         printf("Variable name can't be empty.\n");
  107.         errhand();
  108.     }
  109.     if (ch<'a' || ch>'z') {
  110.         printf("Variable name %s must start with a letter.\n",
  111.                 varname->obstr);
  112.         errhand();
  113.     }
  114.     if (*lptr==NULL) {    /* first cell */
  115.         *lptr=(temp1=(struct alist *)ckzmalloc(sizeof(*temp1)));
  116.     } else {
  117.         for (temp1= *lptr;temp1;temp1=temp1->next) {
  118.             if (!strcmp(temp1->name->obstr,str))
  119.             {    /* name already present */
  120.                 nputs(varname->obstr);
  121.                 printf(" is already defined as a local variable.\n");
  122.                 errhand();
  123.             }
  124.             temp2=temp1;
  125.         }
  126.         /* create new cell at end of string */
  127.         temp2->next=(struct alist *)ckzmalloc(sizeof(*temp2));
  128.         temp1=temp2->next;
  129.     }
  130.     temp1->next=NULL;
  131.     temp1->name=globcopy(objcpstr(str));
  132.     temp1->val=(struct object *)-1;
  133.     lfree(varname);
  134. }
  135.  
  136. struct object *cmlocal(arg)
  137. struct object *arg;
  138. {
  139.     loccreate(globcopy(arg),&locptr);
  140.     mfree(arg);
  141.     return ((struct object *)(-1));
  142. }
  143.  
  144. struct alist *loclk2(str,lap)    /* look for local definition of variable
  145.                 * return cell pointer if found */
  146.         /* BH 5/19/81 was loclk1 but now subprocedure */
  147. register char *str;
  148. register struct alist *lap;
  149. {
  150.     while (lap) {
  151.         if (!strcmp(str,lap->name->obstr)) return(lap);
  152.         lap=lap->next;
  153.     }
  154.     return(NULL);
  155. }
  156.  
  157. struct alist *loclk1(str)    /* look for local definition of variable
  158.                  * WITH DYNAMIC SCOPE!! BH 5/19/81 */
  159. register char *str;
  160. {
  161.     register struct stkframe *skp;
  162.     register struct alist *lap;
  163.  
  164.     if (lap = loclk2(str,locptr)) return(lap);
  165.         /* found in innermost active procedure */
  166.     for (skp = fbr; skp; skp = skp->prevframe) {
  167.         /* else try other active procedures */
  168.         if (skp->loclist)
  169.             if ((lap = loclk2(str,skp->loclist)) != NULL)
  170.                 return(lap);
  171.     }
  172.     return(NULL);
  173. }
  174.  
  175. struct object *alllk(str)    /* return value of variable */
  176. register struct object *str;
  177. {    /* look both locally and globally */
  178.     register struct alist *ap;
  179.     register char *strnm;
  180.  
  181.     if (!stringp(str)) ungood("Thing",str);
  182.     strnm = lowcase(str->obstr);
  183.     if ((ap=loclk1(strnm))==NULL) return(look(str));
  184.     if (ap->val==(struct object *)-1) {
  185.         nputs(strnm);
  186.         puts(" has no value.");
  187.         errhand();
  188.     }
  189.     mfree(str);
  190.     return(localize(ap->val));
  191. }
  192.  
  193. newfr()        /* create new stack frame to accommodate procedure */
  194. {
  195.     register int *temp;
  196.  
  197.     temp=(int *)ckmalloc(PSTKSIZ*sizeof(int));
  198.     *temp=(int)newstk;
  199.     *(newstk+PSTKSIZ-1)=(int)temp;
  200.     newstk=temp;
  201.     newsti=1;
  202. }
  203.  
  204. struct plist *proclook(name)    /* check if procedure already in memory */
  205. register char *name;
  206. {
  207.     register struct plist *here;
  208.  
  209.     for (here=proclist;here;here=here->after)
  210.         if (!strcmp(name,here->procname->obstr)) return(here);
  211.     return(NULL);
  212. }
  213.  
  214. argassign(argval)    /* assign value to next unfilled input */
  215. register struct object *argval;
  216. {
  217.     register struct alist *temp1;
  218.  
  219.     for (temp1=newloc;temp1->val!=(struct object *)-1;temp1=temp1->next) {
  220.         if (!stringp(temp1->name)) {
  221.             printf("Argassign bug trap, newloc messed up.\n");
  222.             return;
  223.         }
  224.     }
  225.     temp1->val=globcopy(argval);
  226.     mfree(argval);
  227.     if (--argno==0) {    /* all inputs filled, so save unparsed token */
  228.         fbr->oldyyl=yylval;
  229.         fbr->oldyyc=yychar;
  230.         if (yyerrflag) return;
  231.         yychar= -1;
  232.     }
  233. }
  234.  
  235. assign(name,val)    /* make */
  236. register struct object *name,*val;
  237. {
  238.     register struct alist *ap;
  239.     register char *namestr;
  240.     char *tmp,ch;
  241.  
  242.     if (!stringp(name)) ungood("Make",name);
  243.     namestr = lowcase(name->obstr);
  244.     for(tmp=namestr;*tmp;tmp++){
  245.         if((*tmp<'a' || *tmp>'z') && (*tmp <'0' || *tmp>'9')
  246.                 && (*tmp != '.') && (*tmp != '_')) {
  247.             pf1("Cannot assign value to %l\n",name);
  248.             errhand();
  249.         }
  250.     }
  251.     if ((ap=loclk1(namestr))) {    /* local definition */
  252.         if (ap->val != (struct object *)-1) lfree(ap->val);
  253.         mfree(name);
  254.         ap->val=globcopy(val);
  255.         mfree(val);
  256.         return;
  257.     }
  258.     else if ((ap=look1(namestr))==0)
  259.     {    /* new variable, so allocate cell */
  260.         if ((ch = namestr[0]) == '\0') {
  261.             printf("Variable name can't be empty.\n");
  262.             errhand();
  263.         }
  264.         if (ch<'a' || ch>'z') {
  265.             printf("Variable name %s must start with a letter.\n",
  266.                     namestr);
  267.             errhand();
  268.         }
  269.         ap=(struct alist *)ckmalloc(sizeof(*ap));
  270.         ap->name = globcopy(objcpstr(namestr));
  271.         ap->next=globvars;
  272.         globvars=ap;
  273.         mfree(name);
  274.     } else {    /* old global definition */
  275.         lfree(ap->val);
  276.         mfree(name);
  277.     }
  278.     ap->val=globcopy(val);
  279.     mfree(val);
  280. }
  281.  
  282. struct object *look(str)    /* return value of globally defined variable */
  283. register struct object *str;
  284. {
  285.     register struct alist *ap;
  286.     register char *strtxt;
  287.  
  288.     if (!stringp(str)) ungood("Thing",str);
  289.     strtxt = lowcase(str->obstr);
  290.     ap=look1(strtxt);
  291.     if (ap==NULL) {
  292.         nputs(strtxt);
  293.         printf(" has no value.\n");
  294.         errhand();
  295.     }
  296.     mfree(str);
  297.     return(localize(ap->val));
  298. }
  299.  
  300. struct alist *look1(str)    /* return pointer to right variable cell */
  301. register char *str;
  302. {
  303.     register struct alist *ap;
  304.  
  305.     for(ap=globvars; ap != 0; ap=ap->next)
  306.         if (!strcmp(str,ap->name->obstr)) return(ap);
  307.     return(0);
  308. }
  309.  
  310.